home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 18 / CU Amiga Magazine's Super CD-ROM 18 (1997)(EMAP Images)(GB)[!][issue 1998-01].iso / CUCD / Programming / ARexxGuide / Arx_Trace.rexx < prev    next >
OS/2 REXX Batch file  |  1994-03-24  |  11KB  |  335 lines
  1. /*    $VER: 1.3   ARx_Trace.rexx   by Robin Evans (14 Oct 1993,12 Mar 1994)  */
  2. /* 1.3: added 'S*' to window specs for WShell users to open it            **
  3. ** on front screen. Fixed some problems with ? option                     */
  4.  
  5. /* Demonstrate various trace options                                      **
  6. **   Thanks to Dean Adams for suggested changes.                          */
  7.  
  8. call trace(b)
  9.  
  10. call addlib('rexxsupport.library',0,-30,0)
  11. signal on syntax; signal on failure
  12.  
  13. LF = '0a'x;    LFS = LF'   '
  14. csi='9b'x;
  15. slant=csi'3m';bold=csi'1m';norm=csi'0m';
  16. black=csi'31m';white=csi'32m';blue=csi'33m'
  17. CLS = csi'0;0H'csi'J';NoCursor = csi'302070'x
  18. CursorOn=csi'2070'
  19. FontSize = FontInfo()
  20. MaxHi = 400
  21.  
  22. Tr. = ''
  23. Tr.1 = I; Tr.I.1Num = 1; Tr.I = 'Intermediates'
  24. Tr.2 = R; Tr.R.1Num = 2; Tr.R = 'Results'
  25. Tr.3 = A; Tr.A.1Num = 3; Tr.A = 'All'
  26. Tr.4 = C; Tr.C.1Num = 4; Tr.C = 'Commands'
  27. Tr.5 = E; Tr.E.1Num = 5; Tr.E = 'Errors'
  28. Tr.6 = N; Tr.N.1Num = 6; Tr.N = 'Normal'
  29. Tr.7 = O; Tr.O.1Num = 7; Tr.O = 'Off'
  30. Tr.8 = B; Tr.B.1Num = 8; Tr.B = 'Background'
  31. Tr.9 = S; Tr.S.1Num = 9; Tr.S = 'Scan'
  32. Tr.10= L; Tr.L.1Num =10; Tr.L = 'Labels'
  33. Char = '?'
  34. Tr.11 = Char; Tr.Char.1Num = 11; Tr.Char = 'Interactive'
  35. Tr.12 = '!'; Tr.!.1Num = 12; Tr.! = 'No commands'
  36.  
  37. ColPos = 90
  38. OpenMode:
  39. if open(ModeWin, 'raw:0/'ColPos'/128/'min(MaxHi, 27*FontSize)'/Modes/NOCLOSE/INACTIVE/NOALT/NOPROP/NOSIZE/SCREEN *', W) then do
  40.         /* cursor invisible, don't wordwrap, move to top left  */
  41.     call writech(ModeWin, '9b3020709b3f376c9b48'x' ')
  42.     call writech(ModeWin, '9b302071'x)
  43.     BoundRpt = readch(ModeWin, 12)
  44.     parse var BoundRpt ';'. ';' WinLines ';' .
  45.     if WinLines < 25 then do
  46.         if MaxHi = 400 then do
  47.             MaxHi = 200
  48.             MinPos = 1
  49.             call close ModeWin
  50.             ColPos = 0
  51.             signal OpenMode
  52.         end
  53.     end
  54.  
  55.     do j = 1 to WinLines%2
  56.         call writeln ModeWin, white||value('Tr.'Tr.j)
  57.         call writeln ModeWin, blue' --'black Tr.j
  58.     end
  59.         /* get window bounds report */
  60. end
  61. else
  62.     signal error
  63.  
  64. ExampleLine = LocateEx()
  65.  
  66.  
  67. ListPos = 14*FontSize
  68. if MinPos = 1 then
  69.     RowPos = 11
  70. else
  71.     RowPos = ListPos - 11
  72.  
  73. ListOpen = open(ListWin, 'con:70/0/468/'ListPos'/Program being traced/NOCLOSE/INACTIVE/SCREEN *', 'W')
  74. if ListOpen then do
  75.         /* cursor invisible */
  76.     call writech(ListWin, NoCursor)
  77.         /* don't word wrap */
  78.     call writech(ListWin, '9b3f376c'x)
  79. end
  80.  
  81.         /* is the trace console open? If so, close it */
  82. if show(F, STDERR) then do
  83.     call writeln(stderr, 'Trying to close this stream')
  84.     address command 'TCC'
  85. end
  86.     /* Turn off global trace flag. OK if it isn't on */
  87. address command 'TE'
  88.  
  89. call close STDOUT
  90. if open(STDOUT, 'con:70/'RowPos'/570/'MaxHi-RowPos'/ARexxGuide Examples/SCREEN *', W) then do
  91.     CurTrace = trace('N')
  92.     if pos('?', CurTrace) then call trace('?')
  93.     call close STDIN
  94.     call open STDIN, "*", R
  95.     call close STDERR
  96.     call open  STDERR, "*"
  97.     say CLS
  98.  
  99.     say white||'This demonstration will show how the various options to the TRACE()'
  100.     say 'function and TRACE instruction affect the display of a program.'
  101.     say LF'We will output the trace to this window rather than redirecting'
  102.     say 'it to the trace console.'||black
  103.  
  104.     if ListOpen then do
  105.         call CopyPrg(ExampleLine ListWin)
  106.         say '0a'x'The program we will trace is listed in the window above.'
  107.         say 'The available modes are listed to the left.'
  108.     end
  109.  
  110.     else
  111.         signal error
  112.     drop i
  113.  
  114.     if AKey() then return 0
  115.     Options prompt white'   Enter the tracing mode to use: 'black
  116.     do MPrompt = 1 until TMode = 'Q'
  117.         say LF||blue'Enter <'black'Q'blue'> to quit or mode code.'black
  118.         pull TMode
  119.         TOpt = ''
  120.         if TMode ~= 'Q' & TMode ~= '' then do
  121.             if verify(TMode, '!?', 'M') > 0 then do
  122.                     /* Is there another char in front of '?' or '!' ? */
  123.                 if verify(TMode, '?!') = 1 then do
  124.                     say 'The characters "?" or "!" must precede the letter option.'
  125.                     iterate MPrompt
  126.                 end
  127.                     /* [TOpt] used for info messages.   */
  128.                 TStr = compress(TMode,'?! ')
  129.                 parse var TMode TOpt (TStr)
  130.                 TMode = TStr
  131.                 if TMode = '' then do
  132.                     TMode = TOpt
  133.                     TOpt = ''
  134.                 end
  135.             end
  136.             else do
  137.                 TOpt = ''
  138.                 TMode = left(TMode, 1)
  139.                 if Tr.Tmode = '' then do
  140.                     say TMode 'is not a recognized trace option.'LF
  141.                     iterate MPrompt
  142.                     end
  143.                 end
  144.                 say CLS
  145.                 say blue'************ TRACE' upper(Tr.TMode)':'black
  146.                 if verify(TOpt,'!','M') > 0 then say white'Commands will not be executed'black
  147.                 if verify(TOpt,'?','M') > 0 | pos('?', TMode) > 0 then do
  148.                     say white'Interactive tracing will be used.'black
  149.                     call IactMsg
  150.                 end
  151.                 select
  152.                     when datatype(TMode, 'N') then do
  153.                         say cls||white'You may enter a positive number to temporarily disable'
  154.                         say 'interactive tracing. A negative number will turn off tracing'
  155.                         say 'altogether for the specified number of lines.'
  156.                         say 'We''ll start the trace as' black'?R'white'.'
  157.                         say blue'At any of the >+> pause points below, you may:'white
  158.                         say '   Enter' black'TRACE' abs(TMode) white'to disable the pause through' abs(TMode) 'lines'
  159.                         say '   Enter' black'TRACE -'abs(TMode) white'to quiet the trace for' abs(TMode) 'lines.'
  160.                         say black'                 Press <Enter> to continue.'NoCursor
  161.                         call readln(STDIN)
  162.                         TMode = '?R'
  163.                     end
  164.                     when Tr.TMode.1Num = 12 then do
  165.                         say white'"!" is one of the options that can be used in conjunction with'
  166.                         say 'any of the letter options.'black
  167.                     end
  168.                     when Tr.TMode.1Num = 11 then do
  169.                         say white'The "?" symbol works as a toggle. We''ll start the trace as'
  170.                         say 'TRACE ?R which will show results. Enter TRACE ? again at any'
  171.                         say 'pause point to end the interactive trace.'black
  172.                         TMode = '?R'
  173.                     end
  174.                     when Tr.TMode.1Num = 10 then do
  175.                         say white'Since there are no function calls in the program being'
  176.                         say 'traced, the "Label" option will be turned on before reaching'
  177.                         say 'the subroutine that contains the code being traced.'black
  178.                         OldT = trace(TMode)
  179.                     end
  180.                     when Tr.TMode.1Num = 9 then do
  181.                         say white'We cannot run a scan trace on a subroutine in this program'
  182.                         say 'because the RETURN that ends the subroutine will not be'
  183.                         say 'recognized. The example will be copied to T: and scanned'
  184.                         say 'from there.'LF||black
  185.                         if ~exists('t:ScanTrace') then
  186.                             if open(1Prg, 't:ScanTrace', W) then do
  187.                                 call writeln(1Prg, '/**/ SIGNAL ON SYNTAX')
  188.                                 call CopyPrg(ExampleLine 1Prg)
  189.                                 call writeln(1Prg, 'SYNTAX:')
  190.                                 call writeln(1Prg, '   return 0')
  191.                                 call close 1Prg
  192.                             end
  193.                         address REXX 't:ScanTrace' TOpt'S'
  194.                         iterate MPrompt
  195.                     end
  196.                     when Tr.TMode.1Num > 6 then do
  197.                         say white'TRACE' Tr.TMode 'will turn off tracing. To see how it works,'
  198.                         say 'enter TRACE' TMode 'at any of the pause points ( >+> ).'
  199.                         say 'You will be presented with one more pause point before the new'
  200.                         say 'option takes effect.'||black
  201.                         TMode = '?R'
  202.                     end
  203.                     when Tr.TMode.1Num = 5 then do
  204.                         say white'This dummy command executed in an external environment'
  205.                         say 'will show how the option works. Note that AmigaDOS outputs'
  206.                         say 'the initial error message -- the first two lines.'LF||black
  207.                         call ErrCmd E
  208.                         iterate MPrompt
  209.                     end
  210.                     when Tr.TMode.1Num = 6 then do
  211.                         say white'TRACE Normal will output only those clauses that contain a'
  212.                         say 'command that sets a return code higher than the current'
  213.                         say 'failure level which would cause the ARexx exec to terminate.'LF
  214.                         say 'This dummy command executed in an external environment'
  215.                         say 'will show how the option works. Note that AmigaDOS outputs'
  216.                         say 'the initial error message -- the first two lines.'LF||black
  217.                         call ErrCmd N
  218.                         iterate MPrompt
  219.                     end
  220.                     when TMode = 'A' then do
  221.                         say white'Only the clauses in the program will be output. Results are not'
  222.                         say 'shown with this option.'LF||black
  223.                     end
  224.                     otherwise
  225.                 end
  226.                 say ''
  227.                 call TracePrg TOpt||TMode
  228.                 if show('F', IactWin) then
  229.                     call close IactWin
  230.                         /* With interactve tracing, it's possible for the user **
  231.                         ** to cause DirFile not to be closed. This makes sure  **
  232.                         ** it is now closed.                                   */
  233.                 if show('F', DirFile) then
  234.                     call close DirFile
  235.                 if exists('t:dirs') then
  236.                     call delete('t:dirs')
  237.                 if pos('L', trace()) > 0 then
  238.                     call trace(OldT)
  239.             end
  240.         end
  241.         call close ListWin
  242.         call close ModeWin
  243.         call close STDOUT
  244.         call close STDIN
  245.         call pragma('*')
  246.     end
  247.     return 0
  248. end
  249. else
  250.     signal error
  251.  
  252. SYNTAX:
  253.     ErrCo = rc
  254. ERROR:
  255. FAILURE:
  256.     signal off SYNTAX            /* to prevent any possibility of an endless loop */
  257.  
  258.     say '0a0a'x||'Sorry, an unexpected error has occurred in line' SIGL
  259.     if datatype(ErrCo, 'N') then
  260.         say '      'ErrCo':' errortext(ErrCo)
  261.     options prompt '                Press <Enter>'
  262.     pull .
  263.     drop ErrCo
  264. return 9
  265.  
  266. BREAK_C:
  267.     return
  268.  
  269. CopyPrg: procedure
  270.  
  271.     arg PgLn1 CopyTo .
  272.     do i = PgLn1 while sourceline(i) ~= 'return'
  273.         call writeln(CopyTo, sourceline(i))
  274.     end
  275. return 0
  276.  
  277. LocateEx:     /* used to locate the line number of the preceding */
  278.     Signal SendLine:
  279. SendLine:
  280.     return Sigl +7
  281.  
  282. TracePrg: procedure expose LF DirFile
  283. signal on failure; signal on break_c
  284.  
  285.  /*******  FileName.rexx  ** Demonstrate TRACE *******/
  286.  arg TMode; call trace TMode; say trace() '--' tmode
  287.  address command "list nohead quick : dirs to t:dirs"
  288.  if open(DirFile, 't:dirs', R) then do
  289.      FDir = readln(DirFile);    call close DirFile
  290.  end
  291.  parse source . . . FilePath .
  292.  DivPos =  1 + max(lastpos(':', FilePath),,
  293.      lastpos('/', FilePath))
  294.  parse var FilePath Dir =DivPos FileName
  295.  say LF'File: "'Filename'" Directory: "'Dir'".'LF
  296. return
  297.  
  298. AKey:
  299.     options prompt LF||blue'   Type <'black'Q'blue'> and <'black'Enter'blue'> to quit. Press <'black'Enter'blue'> alone to continue.'
  300.     pull AKey
  301.     if AKey = Q then return 1
  302.     else return 0
  303.  
  304. IactMsg:
  305.     if open(IactWin, 'con:3/6/472/'9*FontSize'/Interactive tracing options/NOCLOSE/INACTIVE/NOALT/NOPROP/NOSIZE/SCREEN *', W) then do
  306.         call writeln(IactWin, white||'    You have these options at the >+> prompt:')
  307.         call writeln(IactWin, LF' -- Press <'black'Enter'white'> to continue to next clause')
  308.         call writeln(IactWin, ' -- Type = and <'black'Enter'white'> to reexecute previous clause.    ')
  309.         call writeln(IactWin, ' -- Enter any valid ARexx clause.')
  310.         call writeln(IactWin, '    That clause will be interpreted as though it was a')
  311.         call writeln(IactWin, '    part of the program. Try changing the value of the')
  312.         call writeln(IactWin, '    variable [FileName], for instance.')
  313.     end
  314.     else
  315.         signal error
  316. return 0
  317.  
  318. ErrCmd: procedure
  319.     arg TOpt
  320.     signal off failure
  321.     signal off error
  322.     address command "RX ""call trace" TOpt "; address command 'copy foo moo'"""
  323. return
  324.  
  325. FontInfo: procedure
  326.         /* Get default font */
  327.  
  328.     gfxbase=showlist(l, 'graphics.library',,a)
  329.  
  330.     FontAddr = next(gfxbase,154)
  331.     call forbid()
  332.     FSize = c2d(import(offset(FontAddr, 20),2))
  333.     call permit()
  334. return FSize
  335.